Take-Home-EX01

Getting Started

Loading R packages

pacman::p_load(tmap, sf, tidyverse, knitr,dplyr,mapview)

Imorting Data

Importing geospatial data

busstop <- st_read(dsn = "data/geospatial", layer = "BusStop")

Reading layer `BusStop' from data source 
  `D:\zzc\ISSS624\Take-home-Ex1\data\Geospatial' using driver `ESRI Shapefile'
Simple feature collection with 5161 features and 3 fields
Geometry type: POINT
Dimension:     XY
Bounding box:  xmin: 3970.122 ymin: 26482.1 xmax: 48284.56 ymax: 52983.82
Projected CRS: SVY21

Importing OD data

odbus = st_read("data/Apstial/origin_destination_bus_202308.csv")

Reading layer `origin_destination_bus_202308' from data source 
  `D:\zzc\ISSS624\Take-home-Ex1\data\Apstial\origin_destination_bus_202308.csv' 
  using driver `CSV'

Warning: no simple feature geometries present: returning a data.frame or tbl_df

odbus$ORIGIN_PT_CODE <- as.factor(odbus$ORIGIN_PT_CODE)
odbus$DESTINATION_PT_CODE <- as.factor(odbus$DESTINATION_PT_CODE) 
odbus$TOTAL_TRIPS <- as.numeric(odbus$TOTAL_TRIPS)

Extracting the data

Weekday morning peak

odbus6_9 <- odbus %>%
  filter(DAY_TYPE == "WEEKDAY") %>%
  filter(TIME_PER_HOUR >= 6 &
           TIME_PER_HOUR <= 9) %>%
  group_by(ORIGIN_PT_CODE,
           DESTINATION_PT_CODE) %>%
  summarise(TRIPS = sum(TOTAL_TRIPS))

`summarise()` has grouped output by 'ORIGIN_PT_CODE'. You can override using
the `.groups` argument.

Weekday afternoon peak

odbus17_20 <- odbus %>%
  filter(DAY_TYPE == "WEEKDAY") %>%
  filter(TIME_PER_HOUR >= 17 &
           TIME_PER_HOUR <= 20) %>%
  group_by(ORIGIN_PT_CODE,
           DESTINATION_PT_CODE) %>%
  summarise(TRIPS = sum(TOTAL_TRIPS))

`summarise()` has grouped output by 'ORIGIN_PT_CODE'. You can override using
the `.groups` argument.

Weekend/holiday morning peak

odbus11_14 <- odbus %>%
  filter(DAY_TYPE == "WEEKENDS/HOLIDAY") %>%
  filter(TIME_PER_HOUR >= 11 &
           TIME_PER_HOUR <= 14) %>%
  group_by(ORIGIN_PT_CODE,
           DESTINATION_PT_CODE) %>%
  summarise(TRIPS = sum(TOTAL_TRIPS))

`summarise()` has grouped output by 'ORIGIN_PT_CODE'. You can override using
the `.groups` argument.

Weekend/holiday evening peak

odbus16_19 <- odbus %>%
  filter(DAY_TYPE == "WEEKENDS/HOLIDAY") %>%
  filter(TIME_PER_HOUR >= 16 &
           TIME_PER_HOUR <= 19) %>%
  group_by(ORIGIN_PT_CODE,
           DESTINATION_PT_CODE) %>%
  summarise(TRIPS = sum(TOTAL_TRIPS))

`summarise()` has grouped output by 'ORIGIN_PT_CODE'. You can override using
the `.groups` argument.

Create Hexagon grid

area_honeycomb_grid = st_make_grid(busstop, cellsize = 500, what = "polygons", square = FALSE)

# To sf and add grid ID
honeycomb_grid_sf = st_sf(area_honeycomb_grid) %>%
  # add grid ID
  mutate(grid_id = 1:length(lengths(area_honeycomb_grid)))

Geospatial data wrangling

Combining Busstop and mpsz

busstop_hexagon <- st_intersection(busstop, honeycomb_grid_sf) %>%
  select(BUS_STOP_N, grid_id) %>%
  st_drop_geometry()

Warning: attribute variables are assumed to be spatially constant throughout
all geometries

write_rds(busstop_hexagon, "data/rds/busstop_hexagon.csv")  

Left join weekday morning peak

od_data1 <- left_join(odbus6_9 , busstop_hexagon,
            by = c("ORIGIN_PT_CODE" = "BUS_STOP_N")) %>%
  rename(ORIGIN_BS = ORIGIN_PT_CODE,
         ORIGIN_SZ = grid_id) %>%
  group_by(ORIGIN_BS,ORIGIN_SZ) %>%
  summarise(TOT_TRIPS = sum(TRIPS))

Warning in left_join(odbus6_9, busstop_hexagon, by = c(ORIGIN_PT_CODE = "BUS_STOP_N")): Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 25446 of `x` matches multiple rows in `y`.
ℹ Row 3153 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
  "many-to-many"` to silence this warning.

`summarise()` has grouped output by 'ORIGIN_BS'. You can override using the
`.groups` argument.

Left join weekday afternoon peak

od_data2 <- left_join(odbus17_20 , busstop_hexagon,
            by = c("ORIGIN_PT_CODE" = "BUS_STOP_N")) %>%
  rename(ORIGIN_BS = ORIGIN_PT_CODE,
         ORIGIN_SZ = grid_id) %>%
  group_by(ORIGIN_BS,ORIGIN_SZ) %>%
  summarise(TOT_TRIPS = sum(TRIPS))

Warning in left_join(odbus17_20, busstop_hexagon, by = c(ORIGIN_PT_CODE = "BUS_STOP_N")): Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 35040 of `x` matches multiple rows in `y`.
ℹ Row 3153 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
  "many-to-many"` to silence this warning.

`summarise()` has grouped output by 'ORIGIN_BS'. You can override using the
`.groups` argument.

Left join weekend/holiday morning peak

od_data3 <- left_join(odbus11_14 , busstop_hexagon,
            by = c("ORIGIN_PT_CODE" = "BUS_STOP_N")) %>%
  rename(ORIGIN_BS = ORIGIN_PT_CODE,
         ORIGIN_SZ = grid_id) %>%
  group_by(ORIGIN_BS,ORIGIN_SZ) %>%
  summarise(TOT_TRIPS = sum(TRIPS))

Warning in left_join(odbus11_14, busstop_hexagon, by = c(ORIGIN_PT_CODE = "BUS_STOP_N")): Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 27356 of `x` matches multiple rows in `y`.
ℹ Row 3153 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
  "many-to-many"` to silence this warning.

`summarise()` has grouped output by 'ORIGIN_BS'. You can override using the
`.groups` argument.

Left join weekend/holiday evening peak

od_data4 <- left_join(odbus16_19 , busstop_hexagon,
            by = c("ORIGIN_PT_CODE" = "BUS_STOP_N")) %>%
  rename(ORIGIN_BS = ORIGIN_PT_CODE,
         ORIGIN_SZ = grid_id) %>%
  group_by(ORIGIN_BS,ORIGIN_SZ) %>%
  summarise(TOT_TRIPS = sum(TRIPS))

Warning in left_join(odbus16_19, busstop_hexagon, by = c(ORIGIN_PT_CODE = "BUS_STOP_N")): Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 28535 of `x` matches multiple rows in `y`.
ℹ Row 3153 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship =
  "many-to-many"` to silence this warning.

`summarise()` has grouped output by 'ORIGIN_BS'. You can override using the
`.groups` argument.

Checking duplicate records

duplicate1 <- od_data1 %>%
  group_by_all() %>%
  filter(n()>1) %>%
  ungroup()


duplicate2 <- od_data2 %>%
  group_by_all() %>%
  filter(n()>1) %>%
  ungroup()


duplicate3 <- od_data3 %>%
  group_by_all() %>%
  filter(n()>1) %>%
  ungroup()


duplicate4 <- od_data4 %>%
  group_by_all() %>%
  filter(n()>1) %>%
  ungroup()

Retain unique records

od_data1 <- unique(od_data1)
od_data2 <- unique(od_data2)
od_data3 <- unique(od_data3)
od_data4 <- unique(od_data4)

Update od_data data frame with the grid id

origintrip1 <- left_join(honeycomb_grid_sf, 
                           od_data1,
                           by = c("grid_id" = "ORIGIN_SZ"))

origintrip2 <- left_join(honeycomb_grid_sf, 
                           od_data2,
                           by = c("grid_id" = "ORIGIN_SZ"))

origintrip3 <- left_join(honeycomb_grid_sf, 
                           od_data3,
                           by = c("grid_id" = "ORIGIN_SZ"))

origintrip4 <- left_join(honeycomb_grid_sf, 
                           od_data4,
                           by = c("grid_id" = "ORIGIN_SZ"))

Remove grid without value of 0

origintrip1 = filter(origintrip1, TOT_TRIPS > 0)
origintrip2 = filter(origintrip2, TOT_TRIPS > 0)
origintrip3 = filter(origintrip3, TOT_TRIPS > 0)
origintrip4 = filter(origintrip4, TOT_TRIPS > 0)

Creating Interactive map

Weekday morning peak

tmap_mode("view")

tmap mode set to interactive viewing

tmap_options(check.and.fix = TRUE)
tm_shape(origintrip1)+
  tm_fill("TOT_TRIPS", 
          style = "quantile", 
          palette = "Blues",
          title = "Passenger trips") +
  tm_layout(main.title = "Passenger trips generated at planning sub-zone level",
            main.title.position = "center",
            main.title.size = 1.2,
            legend.height = 0.45, 
            legend.width = 0.35,
            frame = TRUE) +
  tm_borders(alpha = 0.5) +
  tm_scale_bar() +
  tm_grid(alpha =0.2) 

weekday afternoon peak

tmap_mode("view")

tmap mode set to interactive viewing

tmap_options(check.and.fix = TRUE)
tm_shape(origintrip2)+
  tm_fill("TOT_TRIPS", 
          style = "quantile", 
          palette = "Blues",
          title = "Passenger trips") +
  tm_layout(main.title = "Passenger trips generated at planning sub-zone level",
            main.title.position = "center",
            main.title.size = 1.2,
            legend.height = 0.45, 
            legend.width = 0.35,
            frame = TRUE) +
  tm_borders(alpha = 0.5) +
  tm_scale_bar() +
  tm_grid(alpha =0.2)

weekend/holiday morning peak

tmap_mode("view")

tmap mode set to interactive viewing

tmap_options(check.and.fix = TRUE)
tm_shape(origintrip3)+
  tm_fill("TOT_TRIPS", 
          style = "quantile", 
          palette = "Blues",
          title = "Passenger trips") +
  tm_layout(main.title = "Passenger trips generated at planning sub-zone level",
            main.title.position = "center",
            main.title.size = 1.2,
            legend.height = 0.45, 
            legend.width = 0.35,
            frame = TRUE) +
  tm_borders(alpha = 0.5) +
  tm_scale_bar() +
  tm_grid(alpha =0.2)

Weekend/holiday evening peak

tmap_mode("view")

tmap mode set to interactive viewing

tmap_options(check.and.fix = TRUE)
tm_shape(origintrip4)+
  tm_fill("TOT_TRIPS", 
          style = "quantile", 
          palette = "Blues",
          title = "Passenger trips") +
  tm_layout(main.title = "Passenger trips generated at planning sub-zone level",
            main.title.position = "center",
            main.title.size = 1.2,
            legend.height = 0.45, 
            legend.width = 0.35,
            frame = TRUE) +
  tm_borders(alpha = 0.5) +
  tm_scale_bar() +
  tm_grid(alpha =0.2)